home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
dateit3a.zip
/
DATEDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-07-18
|
8KB
|
226 lines
{ DateDemo - Date Manipulation Library v.3 }
{ --------------------------------------------------------------------------- }
PROGRAM DateDemo;
{$M 16384,22000,22000}
{$R-,S-,I+,D-,T-,F-,V-,B-,N-,L+}
USES
CRT,Qwik,WndwVars,Wndw,DOS,WWdateit;
TYPE
Str80 = STRING[80];
VAR
Serial: INTEGER;
j,OldCursor,DayOfWeek: WORD;
Date,Date2: dRec;
Ch: CHAR;
Hold: STRING;
const
FuncKey = #00;
RetKey = #13;
EscKey = #27;
StrA : array [1..16] of Str80 = (
'',
'Functions:',
'',
' Julian: - Returns a Julian Number for Given Date',
' LeapYear - Returns 0 for FALSE or 1 for TRUE',
' CkDate - Given Date TRUE or FALSE',
' MonStr - Returns Month number as a string',
' DayStr - Returns Weekday number as a string',
' DateStr - Returns Given Date in string format',
' ComputeDays - Add or Subtract Days from a Given Date',
' Tomorrow - Date after a Given Date',
' Yesterday - Date before a Given Date',
' DiffDates - Return Days/Months Difference between',
' to Dates',
' CompareDates - Compare Date for Equality to, Greater',
' Than or Less Than another Date');
PROCEDURE PressAny; BEGIN
REPEAT
UNTIL (KEYPRESSED);
Ch := READKEY;
END;{PressAny}
PROCEDURE Start; BEGIN
Qwritec(1,1,CRTcols,-1,'WardWares DateIt Demo v.3');
TEXTCOLOR(LightBlue);
Qwritec(4,1,CRTcols,TextAttr,'For each of the following displays:');
Qwrite(5,26,TextAttr,'Press any KEY to continue.');
GETDATE(Date.y,Date.m,Date.d,Date.w);
Qwritec(2,1,CRTcols,-1,DateStr(Date,W1MONTHDY4,Slash));
PressAny;
END;{Start}
PROCEDURE Info; BEGIN
SetWindowModes(ShadowRight);
MakeWindow(4,10,20,60,black+GreenBG,Black+GreenBG,HdoubleBrdr,aWindow);
TitleWindow(Top,Center,' FEATURES ');
WITH TopWndwStat DO BEGIN
FOR j:= 1 to 16 DO
Qwrite(WSrow+j,WScol+1,Black+GreenBG,StrA[j]);
END;{WITH}
PressAny;
END;{Info}
PROCEDURE DoJulian; BEGIN
SetWindowModes(ShadowRight);
MakeWindow(9,13,3,55,Cyan+BlueBG,White+BlueBG,HdoubleBrdr,aWindow);
STR(Julian(Date):3,Hold);
Hold := 'Today''s Julian Date is: '+Hold;
Qwrite(10,19,Cyan+BlueBG,Hold);
PressAny;
RemoveWindow;
END;{DoJulian}
PROCEDURE DoLeapYear; BEGIN
SetWindowModes(ShadowRight);
MakeWindow(10,13,3,55,Cyan+BlueBG,White+BlueBG,HdoubleBrdr,aWindow);
IF (LeapYear(Date.y)=1) THEN
Qwrite(11,19,Cyan+BlueBG,'This is a Leap Year.')
ELSE
Qwrite(11,19,Cyan+BlueBG,'This is NOT a Leap Year.');
PressAny;
RemoveWindow;
END;{DoLeapYear}
PROCEDURE DoCkDate; BEGIN
SetWindowModes(ShadowRight);
MakeWindow(11,13,3,55,Cyan+BlueBG,White+BlueBG,HdoubleBrdr,aWindow);
Date2.m := 7; Date2.d := 33; Date2.y := 1988; Date2.w := 0;
IF (CkDate(Date2)) THEN
Hold := 'Is 7/33/1988 a valid day? YES!'
ELSE
Hold := 'Is 7/33/1988 a valid day? NO!!';
Qwrite(12,19,Cyan+BlueBG,Hold);
PressAny;
RemoveWindow;
END;{DoCkDate}
PROCEDURE DoMonStr; BEGIN
SetWindowModes(ShadowRight);
MakeWindow(12,13,4,55,Cyan+BlueBG,White+BlueBG,HdoubleBrdr,aWindow);
TitleWindow(Top,Left,' and DayStr ');
Hold := 'Month Name Long: '+MonStr(Date.m,Month)+
' or short: '+MonStr(Date.m,Mon);
Qwrite(13,19,Cyan+BlueBG,Hold);
Hold := 'Weekday Name Long: '+DayStr(Date.w,Long)+
' or short: '+DayStr(Date.w,Short);
Qwrite(14,19,Cyan+BlueBG,Hold);
PressAny;
RemoveWindow;
END;{DoMonStr}
PROCEDURE DoDateStr; BEGIN
SetWindowModes(ShadowRight);
MakeWindow(3,5,22,70,Cyan+BlueBG,White+BlueBG,HdoubleBrdr,aWindow);
TitleWindow(Top,Left,' FUNCTION: DateStr ');
Qwrite(7,9,Cyan+BlueBG,'Returns 21 Different String Date Formats');
Qwrite(8,9,Cyan+BlueBG,' with Slashes, Dashes or Periods.');
Qwrite(12,11,Cyan+BlueBG,DateStr(Date,MDY2,Slash));
Qwrite(12,25,Cyan+BlueBG,DateStr(Date,MDY4,Slash));
Qwrite(12,40,Cyan+BlueBG,DateStr(Date,DMY2,Slash));
Qwrite(12,55,Cyan+BlueBG,DateStr(Date,DMY4,Slash));
Qwrite(14,11,Cyan+BlueBG,DateStr(Date,Y2MD,Slash));
Qwrite(14,25,Cyan+BlueBG,DateStr(Date,Y4MD,Slash));
Qwrite(14,40,Cyan+BlueBG,DateStr(Date,MD,Slash));
Qwrite(14,55,Cyan+BlueBG,DateStr(Date,MY2,Slash));
Qwrite(16,11,Cyan+BlueBG,DateStr(Date,MY4,Slash));
Qwrite(16,25,Cyan+BlueBG,DateStr(Date,MONDY2,Slash));
Qwrite(16,40,Cyan+BlueBG,DateStr(Date,MONDY4,Slash));
Qwrite(16,55,Cyan+BlueBG,DateStr(Date,MONTHDY2,Slash));
Qwrite(18,11,Cyan+BlueBG,DateStr(Date,MONTHDY4,Slash));
Qwrite(18,33,Cyan+BlueBG,DateStr(Date,W1MONDY4,Slash));
Qwrite(18,55,Cyan+BlueBG,DateStr(Date,W1MONDY2,Slash));
Qwrite(20,11,Cyan+BlueBG,DateStr(Date,W1MONTHDY2,Slash));
Qwrite(20,33,Cyan+BlueBG,DateStr(Date,W1MONTHDY4,Slash));
Qwrite(20,55,Cyan+BlueBG,DateStr(Date,W2MONDY2,Slash));
Qwrite(22,11,Cyan+BlueBG,DateStr(Date,W2MONDY4,Slash));
Qwrite(22,33,Cyan+BlueBG,DateStr(Date,W2MONTHDY2,Slash));
Qwrite(22,55,Cyan+BlueBG,DateStr(Date,W2MONTHDY4,Slash));
PressAny;
RemoveWindow;
END;{DoDateStr}
PROCEDURE DoComputeDays; BEGIN
SetWindowModes(ShadowRight);
MakeWindow(19,13,7,60,Cyan+BlueBG,White+BlueBG,HdoubleBrdr,aWindow);
TitleWindow(Top,Left,' ComputeDays/Tomorrow/Yesterday/DiffDates ');
ComputeDays(Date,100,Date2,Sub);
Hold := '100 Days before today was: '+DateStr(Date2,MDY4,Dash);
Qwrite(20,17,Cyan+BlueBG,Hold);
ComputeDays(Date,365,Date2,Add);
Hold := '365 Days after today is: '+DateStr(Date2,MDY4,Dash);
Qwrite(21,17,Cyan+BlueBG,Hold);
STR(DiffDates(Date,Date2,Months),Hold);
Hold := 'and is about '+Hold+' months Difference.';
Qwrite(22,17,Cyan+BlueBG,Hold);
Tomorrow(Date,Date2);
Hold := 'Tomorrow''s date is: '+DateStr(Date2,MDY4,Slash);
Qwrite(23,17,Cyan+BlueBG,Hold);
Yesterday(Date,Date2);
Hold := 'Yesterday''s date was: '+DateStr(Date2,MDY4,Slash);
Qwrite(24,17,Cyan+BlueBG,Hold);
PressAny;
RemoveWindow;
END;{DoComputeDays}
PROCEDURE DoComparesDates;
PROCEDURE dWrite; BEGIN
CASE (CompareDates(Date,Date2)) OF
0: Hold := Hold+'equal to '+DateStr(Date2,MDY4,Slash);
1: Hold := Hold+'greater than '+DateStr(Date2,MDY4,Slash);
2: Hold := Hold+'less than '+DateStr(Date2,MDY4,Slash);
END;{CASE}
END;{dWrite}
BEGIN
SetWindowModes(ShadowRight);
MakeWindow(5,13,13,55,Cyan+BlueBG,White+BlueBG,HdoubleBrdr,aWindow);
Hold := 'Today: '+DateStr(Date,MDY4,Slash)+' is ';
dWrite;
Qwrite(7,17,Cyan+BlueBG,Hold);
Qwrite(9,20,Cyan+BlueBG,'Feel Free to Play with this and all of');
Qwrite(10,20,Cyan+BlueBG,'Functions of this toolkit.');
Qwrite(11,20,Cyan+BlueBG,'Registration is $10 and the first 10 people');
Qwrite(12,20,Cyan+BlueBG,'that do so will receive the source code.');
Qwrite(13,20,Cyan+BlueBG,'Thereafter it will cost $25 to receive the');
Qwrite(14,20,Cyan+BlueBG,'source code. So send yours in TODAY!');
PressAny;
RemoveWindow;
END;{DoCompareDates}
PROCEDURE CheckCursor;
VAR
CursorMode: INTEGER ABSOLUTE $0040:$0060;
BEGIN
IF (ActiveDispDev=MdaMono) AND (CursorMode=$0607) THEN
CursorChange($0C0D,OldCursor);
END;{CheckCursor}
BEGIN
InitWindow(Blue+LightGrayBG,TRUE);
CheckCursor;
CursorOff;
Start;
Info;
DoJulian;
DoLeapYear;
DoCkDate;
DoMonStr;
DoDateStr;
DoComputeDays;
DoComparesDates;
PressAny;
RemoveWindow;
Qfill (1,1,25,CRTcols,TextAttr,' ');
Qwritec(12,1,CRTcols,TextAttr,'Copyright 1988 WardWares');
Qwritec(13,1,CRTcols,TextAttr,'1130 NW Washington, Suite 4');
Qwritec(14,1,CRTcols,TextAttr,'Hamilton, OH 45013');
DELAY(2000);
NormVideo;
ClrScr;
CursorOn;
InitWindow(White+BlackBG,TRUE);
CLRSCR;
END.